home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 12 / Cream of the Crop 12 (Part II) / Cream of the Crop 12 (Part II).iso / OS2 / MLRXSHL.ZIP / fl.cmd < prev    next >
Encoding:
Text File  |  1996-02-14  |  39.6 KB  |  1,069 lines
  1. /* fl.cmd - A FILELIST clone                                   960214 */
  2.  
  3. /* Work in progress :
  4.  *
  5.  * implementing 'CURSOR ...';
  6.  * new options: (Append and (File;
  7.  * using REXXUTILS instead of REXXLIB;
  8.  */
  9.  
  10. '@echo off'; trace off
  11.  
  12. call main_init arg(1)
  13. bg = VioReadCellStr(0,0)
  14. w0 = 0 0;                     w0_x = word(w0,1); w0_y = word(w0,2)
  15. w1 = 1 + (commandLine = 1) 6; w1_x = word(w1,1); w1_y = word(w1,2)
  16. w3 = 1 + (commandLine = 1) 0; w3_x = word(w3,1); w3_y = word(w3,2)
  17. w2 = commandLine 0;           w2_x = word(w2,1); w2_y = word(w2,2)
  18. w4 = height+2 0;              w4_x = word(w4,1); w4_y = word(w4,2)
  19. call drawall
  20.  
  21. /* main loop */
  22. do until quit
  23.    if file.level._CURRENT \= commandLine then do
  24.       item = file.level._TOP + file.level._CURRENT - 1
  25.       if item > file.level.0 then do
  26.          item = file.level.0
  27.          if item < file.level._TOP then do
  28.             file.level._TOP = max(1, item - file.level._CURRENT + 1)
  29.             file.level._CURRENT = 0
  30.             call show
  31.             end
  32.          file.level._CURRENT = item - file.level._TOP + 1
  33.          end
  34.       else
  35.       if item < 2 then do
  36.          item = 2
  37.          file.level._CURRENT = 3 - file.level._TOP
  38.          end
  39.       if file.level._WIDE then do
  40.          if file.level._COL = 1 then file.level._COL = 7
  41.          if file.level._COL = 6 then file.level._COL = width
  42.          item = (item-2)*file.level._NCOL + 2 + (file.level._COL-7) % file.level._MAXWIDTH
  43.          if item > file.level.0 then do
  44.             item = file.level.0
  45.             file.level._CURRENT = 3 + (item - file.level._TOP*file.level._NCOL) % file.level._NCOL
  46.             end
  47.          end
  48.       end
  49.    else do
  50.       if redrawCL then do
  51.          call VioWrtCharStr w2_x, w2_y+6, left(command_line, fwidth)
  52.          redrawCL = 0
  53.          end
  54.       item = 2 + (file.level._TOP + currentLine - 3) * file.level._NCOL
  55.       if file.level._COL = 1 then file.level._COL = 7
  56.       if file.level._COL = 6 then file.level._COL = width
  57.       end
  58.    if olditem \= item then do
  59.       call VioWrtCharStr 0, itemnumber, right(item-1,4)
  60.       olditem = item
  61.       end
  62.    call SysCurPos file.level._CURRENT, file.level._COL-1
  63.    key = inkey()
  64.    select
  65.       when symbol('keys._'c2x(key)) = 'VAR' then call execute 'CMDKEY', value('keys._'c2x(key)), item
  66.       when key = CURD then do
  67.          file.level._CURRENT = file.level._CURRENT // (height + 1) + 1
  68.          if file.level._WIDE = 0 & file.level._TOP + file.level._CURRENT - 1 > file.level.0 then file.level._CURRENT = commandLine
  69.          if file.level._WIDE = 1 & (file.level._TOP + file.level._CURRENT - 3) * file.level._NCOL + 2 > file.level.0 then file.level._CURRENT = commandLine
  70.          if file.level._CURRENT = commandLine then file.level._COL = 7
  71.          end
  72.       when key = CURU then do
  73.          if file.level._CURRENT = 1 | file.level._TOP + file.level._CURRENT - 1 <= 2 then do
  74.             file.level._CURRENT = commandLine
  75.             file.level._COL = 7
  76.             end
  77.          else file.level._CURRENT = file.level._CURRENT - 1
  78.          end
  79.       when key = CURR then
  80.          file.level._COL = 1 + file.level._COL // width
  81.       when key = CURL then
  82.          file.level._COL = 1 + (width+file.level._COL-2) // width
  83.       when key = HOME then do
  84.          if file.level._CURRENT = commandLine then do
  85.             file.level._CURRENT = file.level._OLDCURRENT
  86.             file.level._COL = file.level._OLDCOL
  87.             end
  88.          else do
  89.             file.level._OLDCURRENT = file.level._CURRENT
  90.             file.level._OLDCOL = file.level._COL
  91.             file.level._CURRENT = commandLine
  92.             file.level._COL = 7
  93.             end
  94.          end
  95.       when key = ENTER then do
  96.          if file.level._CURRENT = commandLine then do
  97.             if command_line = '' then iterate
  98.             command.cmdnum = command_line
  99.             cmdpos = cmdnum
  100.             cmdnum = cmdnum + 1
  101.             call execute 'CMDLINE', command_line, item
  102.             parse value '1 7' with redrawCL file.level._COL command_line
  103.             end
  104.          else do
  105.             executed = 0
  106.             do idCmd = 1 to file.level.0+1
  107.                if symbol('file.'level'.PCMD.'idCmd) = 'VAR' & file.level.PCMD.idCmd \= '' then do
  108.                   if file.level.PCMD.idCmd = '*' then do
  109.                      drop file.level.PCMD.idCmd
  110.                      iterate
  111.                      end
  112.                   if file.level.PCMD.idCmd \= '"' then
  113.                      cl = file.level.PCMD.idCmd
  114.                   call execute 'PREFIX', cl, idCmd
  115.                   if cmdrc = 0 then
  116.                      file.level.PCMD.idCmd = '*'
  117.                   end
  118.             end /* do */
  119.             if executed then do
  120.                say
  121.                say 'Press any key to continue.'
  122.                call inkey
  123.                call VioWrtCellStr 0, 0, saved_screen
  124.                end
  125.             call show
  126.             end
  127.          if showlevel \= level then do
  128.             level = showlevel
  129.             call redraw
  130.             end
  131.          end
  132.       when length(key) = 1 then call execute 'CMDKEY', 'TEXT 'key
  133.       when key = F2 then
  134.          if list_files(file.level._CURDIR) = 0 then
  135.             call redraw
  136.       when key = F10 then do
  137.          command_line = command.cmdpos
  138.          if cmdpos > 0 then cmdpos = cmdpos - 1
  139.          else if cmdnum > 0 then cmdpos = cmdnum - 1
  140.          call VioWrtCharStr w2_x, w2_y+6, left(command_line, fwidth)
  141.          end
  142.       when key = A_F10 then do
  143.          if cmdnum > 0 then
  144.             cmdpos = (cmdpos + 1) // cmdnum
  145.          command_line = command.cmdpos
  146.          call VioWrtCharStr w2_x, w2_y+6, left(command_line, fwidth)
  147.          end
  148.    otherwise
  149.    end /* select */
  150. end /* do */
  151.  
  152. call SysCurPos row, col
  153. call VioWrtCellStr 0, 0, bg
  154. exit
  155.  
  156. /* redraw current line */
  157. redrawline:
  158.    l = length(file.level.PCMD.item)
  159.    if l < 6 then
  160.       call VioWrtCharStrAttr file.level._CURRENT, 0, file.level._PREFIX.num.item ,,prefixattr
  161.    else
  162.    if l < width then
  163.       if file.level._CURRENT = currentLine then
  164.          call VioWrtCharStrAttr file.level._CURRENT, l, substr(file.level.item,l-2,1) ,,currentattr
  165.       else
  166.          call VioWrtCharStrAttr file.level._CURRENT, l, substr(file.level.item,l-2,1) ,,attr
  167.    call VioWrtCharStrAttr file.level._CURRENT, 0, file.level.PCMD.item ,,prefixcmdattr
  168.    return
  169.  
  170. /* redraw current screen */
  171. drawall:
  172.    call VioScrollUp w2_x, w2_y, w2_x, w2_y+width-1,255,, cmdattr
  173.    do i = 1 to 12
  174.       call w_put w4, 1, (i-1)*8 + 1, i//10, ,attr
  175.       call w_put w4, 1, (i-1)*8 + 2, keyname.i, 7, msgattr
  176.       end
  177. redraw:
  178.    fmode = left(filespec('D',file.level._CURDIR),1)
  179.    fpath = filespec('P',file.level._CURDIR)
  180.    call VioWrtCharStrAttr w2_x, 0, overlay('['wordpos(level,allLevels)']','====> '), ,arrowattr
  181.    call VioWrtCharStrAttr w0_x, w0_y, left(left(file.level._CURDIR,width-23)||,
  182.         right(word(SysDriveInfo(fmode),2)%1024,6)'K disk',width-11)||right(item-1,4)' of'right(file.level.0-1,4), ,msgattr
  183.    call show
  184.    return
  185.  
  186. /* execute CMDLINE, CMDKEY or PREFIX commands */
  187. execute:
  188.    cmd = arg(2)
  189.    parse value '0 1 0' cmd with cmdrc ret nowait verb rest
  190.    verb = alias(verb)
  191.    if verb = 'SET' then do
  192.       parse var rest verb rest
  193.       verb = alias(verb)
  194.       end
  195.    select
  196.       when verb = 'TEXT' then do
  197.          rest = translate(rest,case,xrange('A','Z')xrange('a','z'))
  198.          if file.level._CURRENT = commandLine then do
  199.             command_line = insert(rest, command_line, file.level._COL - 7)
  200.             redrawCL = 1
  201.             end
  202.          else do
  203.             if symbol('file.'level'.PCMD.'item) = 'BAD' then iterate
  204.             if symbol('file.'level'.PCMD.'item) = 'LIT' | file.level.PCMD.item = '*' then do
  205.                file.level.PCMD.item = rest
  206.                file.level._COL = 1
  207.                end
  208.             else
  209.                file.level.PCMD.item = insert(rest, file.level.PCMD.item, file.level._COL - 1)
  210.             call VioWrtCharStrAttr file.level._CURRENT, 0, file.level.PCMD.item ,,prefixcmdattr
  211.             end
  212.          file.level._COL = file.level._COL + length(rest)
  213.          end
  214.       when verb = 'SOS' then
  215.          select
  216.             when abbrev('DELBACK',translate(rest),5) then
  217.                if file.level._CURRENT = commandLine then do
  218.                   if file.level._COL <= 7 then return
  219.                   file.level._COL = file.level._COL - 1
  220.                   command_line = delstr(command_line, file.level._COL - 6, 1)
  221.                   redrawCL = 1
  222.                   end
  223.                else
  224.                if (file.level._COL > 1) & (symbol('file.'level'.PCMD.'item) = 'VAR') then do
  225.                   file.level._COL = file.level._COL - 1
  226.                   file.level.PCMD.item = delstr(file.level.PCMD.item, file.level._COL, 1)
  227.                   call redrawline
  228.                   end
  229.             when abbrev('DELCHAR',translate(rest),4) then
  230.                if file.level._CURRENT = commandLine then do
  231.                   command_line = delstr(command_line, file.level._COL - 6, 1)
  232.                   redrawCL = 1
  233.                   end
  234.                else
  235.                if symbol('file.'level'.PCMD.'item) = 'VAR' then do
  236.                   file.level.PCMD.item = delstr(file.level.PCMD.item, file.level._COL, 1)
  237.                   call redrawline
  238.                   end
  239.             when abbrev('TABFIELDF',translate(rest),8) then
  240.                select
  241.                   when file.level._CURRENT = commandLine then do
  242.                      file.level._CURRENT = 1
  243.                      file.level._COL = 1+file.level._WIDE*6
  244.                      end
  245.                   when file.level._WIDE & file.level._COL-7 < file.level._MAXWIDTH*(file.level._NCOL-1) & item < file.level.0 then
  246.                      file.level._COL = 7+(1+(file.level._COL-7)%file.level._MAXWIDTH)*file.level._MAXWIDTH
  247.                otherwise
  248.                   file.level._CURRENT = file.level._CURRENT // (height + 1) + 1
  249.                   if file.level._WIDE = 0 & file.level._TOP + file.level._CURRENT - 1 > file.level.0 then file.level._CURRENT = commandLine
  250.                   if file.level._WIDE = 1 & (file.level._TOP + file.level._CURRENT - 3) * file.level._NCOL + 2 > file.level.0 then file.level._CURRENT = commandLine
  251.                   file.level._COL = 1+file.level._WIDE*6
  252.                end  /* select */
  253.             when translate(rest) = 'TABFIELDB' then
  254.                select
  255.                   when file.level._CURRENT = commandLine & file.level._COL = 7 then do
  256.                      file.level._CURRENT = file.level._CURRENT - 1
  257.                      file.level._COL = 1+file.level._WIDE*(6+(file.level._NCOL-1)*file.level._MAXWIDTH)
  258.                      end
  259.                   when file.level._COL = 1+6*file.level._WIDE & (file.level._CURRENT = 1 | file.level._TOP + file.level._CURRENT - 1 <= 2) then do
  260.                      file.level._COL = 7
  261.                      file.level._CURRENT = commandLine
  262.                      end
  263.                   when file.level._WIDE & file.level._COL > 7 then
  264.                      file.level._COL = max(7,7+min(file.level._NCOL-1,(file.level._COL+file.level._MAXWIDTH-8)%file.level._MAXWIDTH-1)*file.level._MAXWIDTH)
  265.                   when \file.level._WIDE & file.level._COL > 1 then file.level._COL = 1
  266.                otherwise
  267.                   file.level._CURRENT = file.level._CURRENT - 1
  268.                   file.level._COL = 1+file.level._WIDE*(6+(file.level._NCOL-1)*file.level._MAXWIDTH)
  269.                end  /* select */
  270.             when abbrev('STARTENDCHAR',translate(rest),9) then do
  271.                if file.level._CURRENT = commandLine then
  272.                   len = length(command_line)
  273.                else
  274.                   len = length(file.level.item) - 3
  275.                if file.level._COL = 7 + len then
  276.                   file.level._COL = 7
  277.                else
  278.                   file.level._COL = 7 + len
  279.                end
  280.             when translate(rest) = 'UNDO' then do
  281.                if file.level._CURRENT = commandLine then
  282.                   parse value '1 7' with redrawCL file.level._COL command_line
  283.                else do
  284.                   drop file.level.PCMD.item
  285.                   call VioWrtCharStrAttr file.level._CURRENT, 0, file.level._PREFIX.num.item ,,prefixattr
  286.                   if file.level._CURRENT = currentLine then
  287.                      call VioWrtCharStrAttr file.level._CURRENT, 6, left(substr(file.level.item,4),fwidth),, currentattr
  288.                   else
  289.                      call VioWrtCharStrAttr file.level._CURRENT, 6, left(substr(file.level.item,4),fwidth),, attr
  290.                   end
  291.                end
  292.          otherwise
  293.             call errormsg 'Error 0041: Invalid SOS command:' rest
  294.          end  /* select */
  295.       when verb = 'FLIST' & (arg(1) \= 'CMDLINE' | rest \= '') then do
  296.          if rest = '' then rest = filename(arg(3))
  297.          else if word(rest,1) = '/' then rest = filename(arg(3))'\*.*' subword(rest,2)
  298.          iExec = 1
  299.          do while wordpos(iExec, allLevels) \= 0
  300.             iExec = iExec + 1
  301.          end /* do */
  302.          opath = fpath; omode = fmode; olevel = level
  303.          level = iExec
  304.          if list_files(rest) = 0 then do
  305.             allLevels = subword(allLevels,1,wordpos(olevel, allLevels)) iExec subword(allLevels,wordpos(olevel,allLevels)+1)
  306.             showlevel = iExec
  307.             end
  308.          fpath = opath; fmode = omode; level = olevel
  309.          end
  310.       when verb = 'HELP' then do
  311.          iExec = 1
  312.          do while wordpos(iExec, allLevels) \= 0
  313.             iExec = iExec + 1
  314.          end /* do */
  315.          allLevels = subword(allLevels,1,wordpos(level, allLevels)) iExec subword(allLevels,wordpos(level,allLevels)+1)
  316.          level = iExec
  317.          count = 2
  318.          helpFile = SysSearchPath('DPATH','fl.hlp')
  319.          do while lines(helpFile)
  320.             file.level.count = '   'linein(helpFile)
  321.             file.level._PREFIX.0.count = left(fill,6)
  322.             file.level._PREFIX.1.count = left(right(count-1,length(fill),'0'),6)
  323.             count = count + 1
  324.          end /* do */
  325.          call stream helpFile, 'c', 'close'
  326.          call initlevel helpFile, 'Help', 0, fwidth
  327.          call redraw
  328.          showlevel = level
  329.          end
  330.       when verb = 'TOP' then call execute arg(1), 'BACKWARD *'
  331.       when verb = 'BOTTOM' then call execute arg(1), 'FORWARD *'
  332.       when verb = 'FORWARD' | verb = 'BACKWARD' then do
  333.          if rest = ''  then rest = 1
  334.          if rest = '*' then do
  335.             rest = file.level.0
  336.             if file.level._CURRENT \= commandLine then file.level._CURRENT = currentLine
  337.             end
  338.          if verb = 'FORWARD' then do
  339.             if file.level._TOP = file.level.0 - currentLine + 1 then return
  340.             file.level._TOP = min(file.level._TOP + rest * height, file.level.0 - currentLine + 1)
  341.             if file.level._WIDE then
  342.                file.level._TOP = min(file.level._TOP, (file.level.0-2) % file.level._NCOL - currentLine + 3)
  343.             end
  344.          else do
  345.             if file.level._TOP = -currentLine + 3 then return
  346.             file.level._TOP = max(file.level._TOP - rest * height, -currentLine + 3)
  347.             end
  348.          call show
  349.          end
  350.       /* SET commands */
  351.       when verb = 'COLOR' | verb = 'COLOUR' then do
  352.          parse upper value rest with area rest
  353.          select
  354.             when abbrev('ARROW',area,1) then arrowattr = color(rest,arrowattr)
  355.             when abbrev('CMDLINE',area,1) then cmdattr = color(rest,cmdattr)
  356.             when abbrev('CURLINE',area,2) then currentattr = color(rest,currentattr)
  357.             when abbrev('FILEAREA',area,1) then attr = color(rest,attr)
  358.             when abbrev('IDLINE',area,1) then msgattr = color(rest,msgattr)
  359.             when abbrev('MSGLINE',area,1) then error_attr = color(rest,error_attr)
  360.             when abbrev('PENDING',area,1) then prefixcmdattr = color(rest,prefixcmdattr)
  361.             when abbrev('PREFIX',area,2) then prefixattr = color(rest,prefixattr)
  362.             when abbrev('STATAREA',area,2) then call color rest,0
  363.             when abbrev('TOFEOF',area,2) then call color rest,0
  364.          otherwise
  365.             call errormsg 'Error 0001: Invalid operand:' area
  366.          end  /* select */
  367.          if \inprofile then
  368.             call drawall
  369.          end
  370.       when verb = 'CASE' then
  371.          select
  372.             when abbrev('UPPER',translate(rest),1) then case = xrange('A','Z')xrange('A','Z')
  373.             when abbrev('LOWER',translate(rest),1) then case = xrange('a','z')xrange('a','z')
  374.             when abbrev('MIXED',translate(rest),1) then case = xrange('A','Z')xrange('a','z')
  375.          otherwise
  376.             call errormsg 'Error 0001: Invalid operand:' rest
  377.          end  /* select */
  378.       when verb = 'IMPOS' | abbrev('IMPCMSCP',verb,3) then
  379.          if wordpos(translate(rest),'ON OFF') > 0 then
  380.             impos = 2 - wordpos(translate(rest),'ON OFF')
  381.          else
  382.             call errormsg 'Error 0001: Invalid operand:' rest
  383.       when abbrev('MSGLINE',verb,4) then interpret 'hLine =' subword(rest,2) '; IF hLine < 0 THEN hLine = 2 + height + hLine'
  384.       when abbrev('NUMBER',verb,3) then
  385.          if wordpos(translate(rest),'ON OFF') > 0 then do
  386.             num = 2 - wordpos(translate(rest),'ON OFF')
  387.             if \inprofile then
  388.                call show
  389.             end
  390.          else
  391.             call errormsg 'Error 0001: Invalid operand:' rest
  392.       when abbrev('CURLINE',verb,4) then do
  393.          interpret 'rest =' rest '; IF rest < 0 THEN rest = 1 + height + rest'
  394.          if \inprofile then
  395.             file.level._TOP = file.level._TOP + currentLine - rest
  396.          currentLine = rest
  397.          if \inprofile then
  398.             call show
  399.          end
  400.       /* end of SET commands */
  401.       when verb = 'QUIT' then do
  402.          if words(allLevels) = 1 then do
  403.             quit = 1
  404.             return
  405.             end
  406.          drop file.level.
  407.          level = wordpos(level,allLevels)
  408.          allLevels = delword(allLevels,level,1)
  409.          level = level - 1
  410.          if level = 0 then level = words(allLevels)
  411.          level = word(allLevels,level)
  412.          showlevel = level
  413.          call redraw
  414.          end
  415.       when verb = 'OSNOWAIT' | verb = 'DOSNOWAIT' then
  416.          parse value '0 1' rest with ret nowait cmd
  417.       when verb = 'RUN' | verb = 'OS' | verb = 'DOS' then do
  418.          if rest = '' | translate(rest) = '/O' then
  419.             cmd = value('comspec',,'OS2ENVIRONMENT') '/o'
  420.          else
  421.             cmd = rest
  422.          ret = 0
  423.          end
  424.       when verb = 'NEXTWINDOW' | (verb = 'FLIST' & rest = '' & arg(1) = 'CMDLINE') then do
  425.          nlevel = 1 + wordpos(level,allLevels)
  426.          if nlevel > words(allLevels) then nlevel = 1
  427.          showlevel = word(allLevels,nlevel)
  428.          if level \= showlevel then do
  429.             level = showlevel
  430.             call redraw
  431.             end
  432.          end
  433.       when verb = 'RESET' then do
  434.          rest = translate(rest)
  435.          if (rest = 'ALL') | abbrev('PREFIX',rest,1) then
  436.             do idx = 1 to file.level.0+1
  437.                drop file.level.PCMD.idx
  438.             end /* do */
  439.          call show
  440.          end
  441.       when verb = 'CCANCEL' & arg(1) = 'CMDLINE' then quit = 1
  442.       when verb = '/' then file.level._TOP = item - currentLine + 1
  443.       when verb = 'NEXT' | verb = 'DOWN' then do
  444.          if rest = '' then rest = 1
  445.          if rest = '*' then
  446.             file.level._TOP = file.level.0 - currentLine + 1
  447.          else
  448.             file.level._TOP = min(file.level._TOP + rest, file.level.0 - currentLine + 1)
  449.          if file.level._WIDE then
  450.             file.level._TOP = min(file.level._TOP, (file.level.0-2) % file.level._NCOL - currentLine + 3)
  451.          call show
  452.          end
  453.       when verb = 'UP' then do
  454.          if rest = '' then rest = 1
  455.          if rest = '*' then
  456.             file.level._TOP = -currentLine+3
  457.          else
  458.             file.level._TOP = max(file.level._TOP - rest, -currentLine+3)
  459.          call show
  460.          end
  461.       when verb = 'DEFINE' then do
  462.          parse var rest key rest
  463.          if length(key) > 1 then
  464.             key = value(translate(key,'_','-'))
  465.          if rest \= '' then
  466.             call value 'keys._'c2x(key), rest
  467.          else
  468.             interpret 'drop keys._'c2x(key)
  469.          end
  470.       when verb = 'SHOWKEY' then do
  471.          msg = 'Press the key to be translated...spacebar to exit'
  472.          do forever
  473.             key = errormsg(msg)
  474.             if key = ' ' then leave
  475.             if symbol('keys._'c2x(key)) = 'VAR' then
  476.                msg = 'Key: 'key' - assigned to '''value('keys._'c2x(key))''''
  477.             else
  478.                msg = 'Key: 'key' - unassigned'
  479.          end /* do */
  480.          end
  481.    otherwise
  482.       if impos then
  483.          ret = 0
  484.       else
  485.          call errormsg 'Error 0000: Invalid command: 'cmd
  486.    end /* select */
  487.    if ret then
  488.       return
  489.    if arg(1) \= 'PREFIX' | \ executed then do
  490.       saved_screen = VioReadCellStr(0,0,(height+3)*width*2)
  491.       call SysCls
  492.       executed = 1
  493.       end
  494.    prompt = prompt()
  495.    signal on halt
  496.    if arg(1) \= 'CMDLINE' then
  497.       cmd = substitute(cmd,arg(3))
  498.    else
  499.       cmd = substitute(cmd '/o',arg(3))
  500.    say prompt||cmd
  501.    address cmd cmd
  502.    cmdrc = rc
  503. after_halt:
  504.    if arg(1) \= 'PREFIX' then do
  505.       if \ nowait then do
  506.          say
  507.          say 'Press any key to continue.'
  508.          call inkey
  509.          end
  510.       call VioWrtCellStr 0, 0, saved_screen
  511.       end
  512.    return
  513.  
  514. /* handle control break */
  515. /* this should be activated only from the 'execute' routine */
  516. halt:
  517.    signal after_halt
  518.  
  519. /* parse command line & perform substitutions */
  520. substitute: procedure expose file. fmode fpath level
  521.    parse arg verb rest, item
  522.    if verb = '/' then do
  523.       parse arg rest, item
  524.       verb = ''
  525.       end
  526.    parse value '0 0' with state subst tail
  527.    parse var file.level.item 4 fdate ftime fsize fileid
  528.    fileid = strip(fileid)
  529.    if pos('.',fileid) \= 0 then do
  530.       fn = substr(fileid,1,lastpos('.',fileid)-1)
  531.       ft = substr(fileid,lastpos('.',fileid)+1)
  532.       end
  533.    else do
  534.       fn = fileid
  535.       ft = ''
  536.       end
  537.    do i = 1 to length(rest)
  538.       c = translate(substr(rest,i,1))
  539.       select
  540.          when state = 0 then do
  541.             if c = '/' then state = 1
  542.             else tail = tail||substr(rest,i,1)
  543.             end
  544.          when state = 1 then do
  545.             select
  546.                when c = 'N' then do
  547.                   tail = tail||fn
  548.                   subst = 1
  549.                   end
  550.                when c = 'T' | c = 'E' then do
  551.                   tail = tail||ft
  552.                   subst = 1
  553.                   end
  554.                when c = 'D' | c = 'M' then do
  555.                   tail = tail||fmode':'
  556.                   subst = 1
  557.                   end
  558.                when c = 'P' then do
  559.                   tail = tail||fpath
  560.                   subst = 1
  561.                   end
  562.                when c == ' ' then do
  563.                   tail = tail||filename(item)||' '
  564.                   subst = 1
  565.                   end
  566.                when c = 'O' then do
  567.                   subst = 1
  568.                   end
  569.             otherwise do
  570.                tail = tail||substr(rest,i,1)
  571.                end
  572.             end /* inner select */
  573.             state = 0
  574.             end /* do group */
  575.       end /* outer select */
  576.    end /* outer loop */
  577.  
  578.    if state then tail = tail||filename(item)
  579.  
  580.    if \subst then do
  581.       fname = filename(item)
  582.       if tail \== '' then
  583.          tail = tail fname
  584.       else
  585.          tail = fname
  586.       end
  587.  
  588.    verb = alias(verb)
  589.    return verb tail
  590.  
  591. /* compute a file name */
  592. filename: procedure expose file. fmode fpath level
  593.    arg item
  594.    parse var file.level.item 4 fdate ftime fsize fileid
  595.    fileid = fmode':'||fpath||strip(fileid)
  596.  
  597.    if pos(' ',fileid) \= 0 then
  598.       return '"'fileid'"'
  599.    else
  600.       return fileid
  601.  
  602. /* expand the OS/2 prompt */
  603. prompt: procedure
  604.    prmpt = value('PROMPT',,'OS2ENVIRONMENT')
  605.    if (prmpt == '') then
  606.       prmpt = '[$p]'
  607.  
  608.    str = ''
  609.  
  610.    do i = 1 to length(prmpt)
  611.       key = substr(prmpt,i,1)
  612.       if (key = '$') then
  613.          do
  614.          i = i+1; key = translate(substr(prmpt,i,1))
  615.          select
  616.             when key = '$' then str = str||'$'
  617.             when key = 'A' then str = str||'&'
  618.             when key = 'B' then str = str||'|'
  619.             when key = 'C' then str = str||'('
  620.             when key = 'D' then str = str||date()
  621.             when key = 'E' then str = str||'1b'x
  622.             when key = 'F' then str = str||')'
  623.             when key = 'G' then str = str||'>'
  624.             when key = 'H' then str = str||'08'x
  625.             when key = 'I' then nop
  626.             when key = 'L' then str = str||'<'
  627.             when key = 'N' then str = str||filespec("d",directory())
  628.             when key = 'P' then str = str||directory()
  629.             when key = 'Q' then str = str||'='
  630.             when key = 'R' then str = str||rc
  631.             when key = 'S' then str = str||' '
  632.             when key = 'T' then str = str||time()
  633.             when key = 'V' then str = str||'Operating System/2 version' SysOS2Ver()
  634.             when key = '_' then str = str||'0d'x
  635.          otherwise
  636.             str = str||substr(prmpt,i,1)
  637.          end  /* select */
  638.          end
  639.       else
  640.          str = str||key
  641.    end /* do */
  642.    return str
  643.  
  644. /* compute a command alias */
  645. alias:
  646.    word = translate(arg(1))
  647.    do i = 1 by 1 while symbol('abbr.i.name') = 'VAR'
  648.       if abbrev(abbr.i.name,word,abbr.i.min) then
  649.          return abbr.i.name
  650.    end /* do */
  651.    return word
  652.  
  653. /* expand file spec */
  654. expandspec:
  655.    fmode = filespec('d',arg(1))
  656.    fpath = filespec('p',arg(1))
  657.    fname = filespec('n',arg(1))
  658.    if fmode = '' then
  659.       fmode = filespec('d',directory())
  660.    if fpath = '' then
  661.       fpath = doscd(substr(fmode,1,1))
  662.    if right(fpath,1) \= '\' then
  663.       fpath = fpath||'\'
  664.    if fname = '' then
  665.       fname = '*'
  666.    if pos('*',fname) = 0 then
  667.       fname = fname||'\*'
  668.    if \fileexists then do
  669.       fileexists = stream(fmode||fpath||fname,'c','query exists') \= ''
  670.       if \fileexists then do
  671.          call SysFileTree fmode||fpath||fname, FEXIST.
  672.          fileexists = (FEXIST.0 \= 0)
  673.          end
  674.       end
  675.    return fmode||fpath||fname
  676.  
  677. /* build the list of files */
  678. list_files:
  679.    drop file.level.
  680.    parse arg list '(' options
  681.    if list = '' then
  682.       list = '*'
  683.    filespec = ''
  684.    fileexists = 0
  685.    do while list \= ''
  686.       parse value list with pre '"' main '"' list
  687.       do i = 1 to words(pre)
  688.          filespec = filespec expandspec(word(pre,i))
  689.       end /* do */
  690.       if main \= '' then
  691.          filespec = filespec '"'expandspec(main)'"'
  692.    end /* do */
  693.    filespec = strip(filespec)
  694.  
  695.    /* scan options */
  696.    parse value '0 0' translate(options) with tree_option sort_option options
  697.    do i = 1 to words(options)
  698.       opt = word(options,i)
  699.       if abbrev('TREE',opt,2) then
  700.          tree_option = 1
  701.       else if abbrev('SORTD',opt,4) | abbrev('SORTA',opt,4) then
  702.          sort_option = 1
  703.    end /* do */
  704.  
  705.    if \tree_option & \fileexists then do
  706.       call errormsg 'Error 0009: Files not found:' filespec
  707.       return 2
  708.       end
  709.  
  710.    if sort_option then
  711.       sort = ''
  712.    else do
  713.       if tree_option then
  714.          sort = 'sort path sortd d'
  715.       else
  716.          sort = 'sort n'
  717.       end
  718.  
  719.    call listfile filespec '(' sort options
  720.    count = file.level.0
  721.    if rc \= 0 then
  722.       return 1
  723.    return 0
  724.  
  725. /* show the list of files */
  726. show:
  727.    if file.level._WIDE \= 1 then
  728.       do i = 0 to height-1
  729.          index = file.level._TOP + i; delta = w1_x+i /* = w3_x+i */
  730.          if index < 1 | index > 1 + file.level.0 then do
  731.             call VioWrtCharStrAttr delta, w3_y, prefixSpace,,prefixattr
  732.             call VioWrtCharStrAttr delta, w1_y, mainSpace,,attr
  733.             iterate
  734.             end
  735.          call VioWrtCharStrAttr delta, w3_y, file.level._PREFIX.num.index,,prefixattr
  736.          if i+1 = currentLine then
  737.             call VioWrtCharStrAttr delta, w1_y, left(substr(file.level.index,4),fwidth) ,,currentattr
  738.          else
  739.             call VioWrtCharStrAttr delta, w1_y, left(substr(file.level.index,4),fwidth) ,,attr
  740.          if (symbol('file.'level'.PCMD.'index) = 'VAR') then
  741.             call VioWrtCharStrAttr delta, 0, file.level.PCMD.index ,,prefixcmdattr
  742.       end /* do */
  743.    else
  744.       do i = 1 to height
  745.          index = file.level._TOP + i - 1
  746.          if index <= 1 | 3+(index-2)*file.level._NCOL > 1 + file.level.0 then do
  747.             call w_put w3, i, 1, '      ', ,prefixattr
  748.             if index < 1 | 3+(index-3)*file.level._NCOL > 1 + file.level.0 then call w_put w1, i, 1, '', fwidth, attr
  749.             else
  750.             if index = 1 then call w_put w1, i, 1, substr(file.level.1,4), fwidth, attr
  751.             else
  752.                call w_put w1, i, 1, substr(value('file.level.'file.level.0+1),4), fwidth, attr
  753.             iterate
  754.             end
  755.          index = 2+(index-2)*file.level._NCOL
  756.          shortnames = ''
  757.          call w_put w3, i, 1, file.level._PREFIX.num.index, ,prefixattr
  758.          do j = index to index+file.level._NCOL-1
  759.             if substr(file.level.j,31,1) = '>' then
  760.                shortnames = shortnames||'['substr(file.level.j']',34,file.level._MAXWIDTH-1)
  761.             else
  762.                shortnames = shortnames||substr(file.level.j,34,file.level._MAXWIDTH)
  763.          end /* do */
  764.          if i = currentLine then
  765.             call w_put w1, i, 1, shortnames, fwidth, currentAttr
  766.          else
  767.             call w_put w1, i, 1, shortnames, fwidth, attr
  768.       end /* do */
  769.    return
  770.  
  771. /* show error messages */
  772. errormsg:
  773.    if inprofile then do
  774.       say arg(1)
  775.       return
  776.       end
  777.    save1 = VioReadCellStr(hline-1,0,width*2)
  778.    call VioWrtCharStrAttr hline-1, 0, left(arg(1),width), width, error_attr
  779.    key = inkey()
  780.    call VioWrtCellStr hline-1, 0, save1
  781.    return key
  782.  
  783. /* simulate listfile command */
  784. listfile: procedure expose file. rc height fill level currentLine commandLine olevel fwidth
  785.    parse arg names '(' options
  786.    parse value '0 0 /NAME /EXT /SIZE /DATE' with wide sorts sort_types
  787.    do i = 1 to words(options)
  788.       opt = translate(word(options, i))
  789.       select
  790.          when opt = 'SORT' | opt = 'SORTA' then do
  791.             if i = words(options) then
  792.                break
  793.             i = i + 1
  794.             sorts = sorts + 1
  795.             x = pos('/'translate(word(options, i)), sort_types)
  796.             parse var sort_types =(x) '/' sortype .
  797.             sort.sorts = sortype 'a'
  798.             end
  799.          when opt = 'SORTD' then do
  800.             if i = words(options) then
  801.                break
  802.             i = i + 1
  803.             sorts = sorts + 1
  804.             x = pos('/'translate(word(options, i)), sort_types)
  805.             parse var sort_types =(x) '/' sortype .
  806.             sort.sorts = sortype 'd'
  807.             end
  808.          when abbrev('WIDE',opt,1) | abbrev('(WIDE',opt,2) then wide = 1
  809.          when opt = 'APPEND' | opt = '(APPEND' then nop
  810.       otherwise
  811.       end /* select */
  812.    end /* do */
  813.  
  814.    count = 1
  815.    do while names \= ''
  816.       parse value names with file _ '"' main '"' names
  817.       select
  818.          when file = '' & main = '' then iterate
  819.          when file = '' then file = main
  820.          when main = '' then names = _ names
  821.       otherwise
  822.          names = _ '"'main'"' names
  823.       end  /* select */
  824.       lastfile = file
  825.  
  826.       /* SysFileTree is broken when used w/ TVFS, so I've to check... */
  827.       if word(SysDriveInfo(filespec('D',file)),4) = 'TVFS' then
  828.          call SysFileTree file, 'temp', 'D'
  829.       else
  830.          call SysFileTree file, 'temp'
  831.  
  832.       maxwidth = 0
  833.       do j = 1 to temp.0
  834.          parse var temp.j dt tm sz at fid
  835.          count = count + 1
  836.          fspec = filespec('n', fid)
  837.          x = lastpos('.', fspec)
  838.          if x = 0 then do
  839.             fn = fspec
  840.             ft = ''
  841.             end
  842.          else do
  843.             fn = left(fspec, x-1)
  844.             ft = substr(fspec, x+1)
  845.             end
  846.          if pos('D',at) \= 0 then do
  847.             sz = '<dir>'
  848.             end
  849.          file.level.count = left(ft,3)right(dt, 8)'  'right(tm,6)'  'right(sz,10)'  'fspec
  850.          maxwidth = max(maxwidth,length(fspec)+2*(pos('D',at) \= 0))
  851.          file.level._PREFIX.0.count = left(fill,6)
  852.          file.level._PREFIX.1.count = left(right(count-1,length(fill),'0'),6)
  853.       end /* do */
  854.    end /* do */
  855.    count = count+1
  856.    call initlevel lastfile, "List", wide, maxwidth
  857.  
  858.    /* build an arglist for arraysort */
  859.    sortspec = ''
  860.    do i = 1 to sorts
  861.       parse var sort.i type direction
  862.       select
  863.          when type = 'DATE' then
  864.             sortspec = sortspec||'10,2,"'direction'","c",4,5,"'direction'","c",'
  865.          when type = 'NAME' then
  866.             sortspec = sortspec||'34,,"'direction'","c",'
  867.          when type = 'EXT' then
  868.             sortspec = sortspec||'1,3,"'direction'","c",34,,"a","c",'
  869.          when type = 'SIZE' then
  870.             sortspec = sortspec||'22,10,"'direction'","c",'
  871.       otherwise
  872.       end /* select */
  873.    end /* do */
  874. /*   interpret 'call arraysort "file."level,2,count-2,'strip(sortspec,'t',',') */
  875.    rc = 0
  876.    return
  877.  
  878. /* initialize level data  --  arg(1) is level title & arg(2) is level type */
  879. initlevel:
  880.    file.level.1 = "   ═════ Top Of "arg(2)" ═════"
  881.    file.level._PREFIX.0.1 = '      '
  882.    file.level._PREFIX.1.1 = '      '
  883.    file.level.count = "   ═════ Bottom Of "arg(2)" ═════"
  884.    file.level._PREFIX.0.count = '      '
  885.    file.level._PREFIX.1.count = '      '
  886.    file.level._TOP = -currentLine+3
  887.    file.level._CURRENT = commandLine
  888.    file.level._COL = 7
  889.    file.level._OLDCOL = 7
  890.    file.level._OLDCURRENT = 2
  891.    file.level._CURDIR = arg(1)
  892.    file.level._WIDE = arg(3)
  893.    file.level._MAXWIDTH = arg(4)+2
  894.    if arg(3) then
  895.       file.level._NCOL = fwidth % (arg(4)+2)
  896.    else
  897.       file.level._NCOL = 1
  898.    file.level.0 = count-1
  899.    return
  900.  
  901. /* initialize data and global variables */
  902. main_init:
  903.  
  904.    if RxFuncQuery("SysLoadFuncs") then
  905.       do
  906.       call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs'
  907.       call SysLoadFuncs
  908.       end
  909.  
  910.    if RxFuncQuery("VioLoadFuncs") then
  911.       do
  912.       call RxFuncAdd 'VioLoadFuncs', 'REXXVIO', 'VioLoadFuncs'
  913.       call VioLoadFuncs
  914.       end
  915.  
  916.    ESC = '1b'x;                     keys._1B   = 'sos undo'
  917.    ENTER = '0d'x
  918.    BKSP = '08'x;                    keys._08   = 'sos delback'
  919.    TAB = '09'x;                     keys._09   = 'sos tabfieldf'
  920.    S_TAB = '000F'x;                 keys._000F = 'sos tabfieldb'
  921.    DEL = '0053'x;                   keys._0053 = 'sos delchar'
  922.    CURU = '0048'x
  923.    CURD = '0050'x
  924.    CURL = '004b'x
  925.    CURR = '004d'x
  926.    PGUP = '0049'x;                  keys._0049 = 'backward 1'
  927.    PGDN = '0051'x;                  keys._0051 = 'forward 1'
  928.    C_PGUP = '0084'x;                keys._0084 = 'backward *'
  929.    C_PGDN = '0076'x;                keys._0076 = 'forward *'
  930.    HOME = '0047'x
  931.    END = '004F'x;                   keys._004F = 'sos startendchar'
  932.    F1 = '003b'x;                    keys._003B = 'help'
  933.    F2 = '003c'x
  934.    F3 = '003d'x;                    keys._003D = 'quit'
  935.    F4 = '003e'x;                    keys._003E = 'the'
  936.    F5 = '003f'x;                    keys._003F = 'copy / a:'
  937.    F6 = '0040'x;                    keys._0040 = 'copy / b:'
  938.    F7 = '0041'x
  939.    F8 = '0042'x;                    keys._0042 = 'os'
  940.    F9 = '0043'x;                    keys._0043 = 'osnowait call less'
  941.    F10 = '0044'x
  942.    F11 = '0085'x
  943.    F12 = '0086'x;                   keys._0086 = 'nextwindow'
  944.    A_F10 = '0071'x
  945.  
  946.    /* abbreviations */
  947.    abbr.1.name = 'FB';              abbr.1.min = 1
  948.    abbr.2.name = 'BROWSE';          abbr.2.min = 1
  949.    abbr.3.name = 'FLIST';           abbr.3.min = 2
  950.    abbr.4.name = 'RESET';           abbr.4.min = 3
  951.    abbr.5.name = 'NEXTWINDOW';      abbr.5.min = 5
  952.    abbr.6.name = 'CCANCEL';         abbr.6.min = 2
  953.    abbr.7.name = 'BOTTOM';          abbr.7.min = 3
  954.    abbr.8.name = 'BACKWARD';        abbr.8.min = 2
  955.    abbr.9.name = 'FORWARD';         abbr.9.min = 2
  956.    abbr.10.name = 'NEXT';           abbr.10.min = 1
  957.    abbr.11.name = 'UP';             abbr.11.min = 1
  958.    abbr.12.name = 'DOWN';           abbr.12.min = 1
  959.    abbr.13.name = 'SHOWKEY';        abbr.13.min = 4
  960.    abbr.14.name = 'DEFINE';         abbr.14.min = 3
  961.    abbr.15.name = 'OSNOWAIT';       abbr.15.min = 3
  962.    abbr.16.name = 'DOSNOWAIT';      abbr.16.min = 4
  963.  
  964.    parse value '1 1 1' SysTextScreenSize() SysCurPos(),
  965.          with showlevel level allLevels height width row col command_line command.
  966.  
  967.    height = height - 3
  968.  
  969.    parse value height%2 width-11 '2 0 0 0 0 0 0 ======',
  970.          with M itemnumber item olevel cmdpos cmdnum redrawCL quit executed fill
  971.  
  972.    /* main area color */
  973.    parse value '116 23 49 49 49 113 116 31',
  974.          with error_attr attr cmdattr arrowattr prefixattr msgattr prefixcmdattr currentattr
  975.  
  976.    /* SETtable values */
  977.    parse value xrange('A','Z')xrange('a','z') width-6 height+1 '0 1 7 2',
  978.          with case fwidth commandLine num impos currentLine hLine
  979.  
  980.    prefixSpace = '      '
  981.    mainSpace = copies(' ',fwidth)
  982.  
  983.    /* key names */
  984.    keyname.1 = 'Help'
  985.    keyname.2 = 'Refresh'
  986.    keyname.3 = 'Exit'
  987.    keyname.4 = 'Xedit'
  988.    keyname.5 = 'Copy A'
  989.    keyname.6 = 'Copy B'
  990.    keyname.7 = ''
  991.    keyname.8 = 'Shell'
  992.    keyname.9 =  'FB'
  993.    keyname.10 = 'Recall'
  994.    keyname.11 = ''
  995.    keyname.12 = 'NextW'
  996.  
  997.    /* profile support */
  998.    profileName = 'profile.fl'
  999.  
  1000.    parse upper value arg(1) with _ '(N' +0 profile
  1001.    if abbrev('(NOPROFILE',word(profile,1),2) then
  1002.       profileName = ''
  1003.  
  1004.    parse upper value arg(1) with _ '(P' +0 profile
  1005.    if abbrev('(PROFILE',word(profile,1),2) then
  1006.       profileName = word(profile,2)
  1007.  
  1008.    inprofile = 1
  1009.    if profileName \= '' then
  1010.       profileFile = SysSearchPath('DPATH',profileName)
  1011.    if profileFile \= '' then do
  1012.       do while lines(profileFile)
  1013.          line = linein(profileFile)
  1014.          if left(line,1) = "'" | left(line,1) = '"' then
  1015.             call execute 'CMDLINE', strip(line,,left(line,1))
  1016.          else
  1017.             interpret line
  1018.       end /* do */
  1019.       call stream profileFile, 'c', 'close'
  1020.       end
  1021.    if list_files(arg(1)) \= 0 then
  1022.       exit 3
  1023.    inprofile = 0
  1024.  
  1025.    return
  1026.  
  1027. /* convert color name */
  1028. color: procedure expose hline width error_attr inprofile
  1029.    arg word1 rest
  1030.    parse value '0 0 BLACK BLUE GREEN CYAN RED MAGENTA YELLOW WHITE' with col bg name
  1031.    do while word1 \= ''
  1032.       select
  1033.          when \bg & word1 = 'BLINK' then col = col + 128
  1034.          when \bg & wordpos(word1,'BOLD BRIGHT HIGH') > 0 then col = col + 8
  1035.          when \bg & wordpos(word1,name) > 0 then do
  1036.             col = col + wordpos(word1,name) - 1
  1037.             bg = 1
  1038.             end
  1039.          when bg & wordpos(word1,name) > 0 then col = col + 16 * (wordpos(word1,name)-1)
  1040.       otherwise
  1041.          call errormsg 'Error 0001: Invalid operand:' word1
  1042.          return arg(2)
  1043.       end  /* select */
  1044.       parse value rest with word1 rest
  1045.    end /* do */
  1046.    return col
  1047.  
  1048. /* quick and dirty rexxlib replacement funcs */
  1049. doscd: procedure
  1050.   arg drive
  1051.   current = directory()
  1052.   specified = directory(drive':')
  1053.   call directory current
  1054.   return substr(specified,3)
  1055.  
  1056. w_put:
  1057.   if arg(5) = '' then
  1058.     return VioWrtCharStrAttr(word(arg(1),1)+arg(2)-1,word(arg(1),2)+arg(3)-1,arg(4),,arg(6))
  1059.   else
  1060.     return VioWrtCharStrAttr(word(arg(1),1)+arg(2)-1,word(arg(1),2)+arg(3)-1,left(arg(4),arg(5)),arg(5),arg(6))
  1061.  
  1062. inkey: procedure
  1063.   key  = SysGetKey("NOECHO")
  1064.                          
  1065.   if (key = "E0"x) | (key = "00"x) then        
  1066.     return "00"x || SysGetKey("NOECHO")
  1067.   else
  1068.     return key
  1069.